SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00007 SCREEN SCROLLING ROUTINES 1 05-28-9313:56ALL SWAG SUPPORT TEAM SCROLL1.PAS IMPORT 14 B╡=í {π>It's just a Fileviewer, I'm working on. I just want to be able toπ>scroll the File up, down, etc.π}ππProgram ScrollDemo;πUsesπ Crt;πTypeπ UpDown = (Up, Down);π { Scroll Text screen up or down. }ππProcedure Scroll({input } Direction : UpDown;π Lines2Scroll,π Rowtop,π RowBot,π ColStart,π ColStop,π FillAttr : Byte);πbeginπ if (Direction = Up) thenπ Asmπ mov ah, 06hπ mov al, Lines2Scrollπ mov bh, FillAttrπ mov ch, Rowtopπ mov cl, ColStartπ mov dh, RowBotπ mov dl, ColStopπ int 10hπ endπ elseπ Asmπ mov ah, 07hπ mov al, Lines2Scrollπ mov bh, FillAttrπ mov ch, Rowtopπ mov cl, ColStartπ mov dh, RowBotπ mov dl, ColStopπ int 10hπ endπend; { Scroll }ππ{ Pause For a key press. }πProcedure Pause;πVarπ chTemp : Char;πbeginπ While KeyPressed doπ chTemp := ReadKey;π Repeat Until(KeyPressed)πend; { Pause }ππVarπ Index : Byte;π stTemp : String[80];πbeginπ ClrScr;π { Display 24 lines of Text. }π For Index := 1 to 24 doπ beginπ stTemp[0] := #80;π fillChar(stTemp[1], length(stTemp), (Index + 64));π Write(stTemp)π end;π { Pause For a key press. }π Pause;π { Scroll Text down by 1 line. Use the Crt's Textattr }π { Variable as the Text color to fill with. }π Scroll(Down, 1, 0, 24, 0, 79, Textattr);π { Pause For a key press. }π Pause;π { Scroll Text up by 1 line. Use the Crt's Textattr }π { Variable as the Text color to fill with. }π Scroll(Up, 1, 0, 24, 0, 79, Textattr);π { Pause For a key press. }π Pauseπend.π 2 05-28-9313:56ALL SWAG SUPPORT TEAM SCROLL2.PAS IMPORT 53 B╡Y8 Program Scroll;πUsesπ Crt, Dos;πConstπ Null = #0;π UpArrow = #72;π LeftArrow = #75;π RightArrow = #77;π DownArrow = #80;π PageUp = #73;π PageDown = #81;π ESC = #27;ππTypeπ StrPtr = ^LineBuffer;ππ LineBuffer = Recordπ Line : String[255];π Next : StrPtr;π Prev : StrPtr;π Up23 : StrPtr;π Down23 : StrPtr;π end;πVarπ F : Text;π First,π Last,π Prev,π Current : StrPtr;π Line : Byte;π Row : Byte;ππFunction PadString( S : String ) : String;πVarπ X : Byte;πbeginπ if ord(S[0]) > 79 then S[0]:=Chr(80);π For X := (Length(S) + 1) to 79 Doπ S[X] := ' ';π S[0] := Chr(79);π PadString := S;πend;ππProcedure Normal;πbeginπ TextColor(15);π TextBackGround(0);πend;ππProcedure HighLite;πbeginπ TextColor(10);π TextBackGround(7);πend;ππProcedure AddString;πVarπ S : String;ππbeginπ if First = Nil thenπ beginπ Line := 1;π New(Current);π Current^.Prev := Nil;π Current^.Next := Nil;π Current^.Up23 := Nil;π Current^.Down23 := Nil;π ReadLn(F, S);π Current^.Line := S;π Last := Current;π First := Current;π endπ elseπ beginπ Prev := Current;π New(Current);π Current^.Prev:=Prev;π Current^.Next:=Nil;π ReadLn(F,Current^.Line);π if Line = 23 thenπ beginπ Current^.Up23 := First;π First^.Down23 := Current;π Current^.Down23:= Nil;π endπ elseπ beginπ if Line > 23 thenπ beginπ Current^.Up23 := Prev^.Up23^.Next;π Current^.Up23^.Down23 := Current;π Current^.Down23:=Nil;π endπ elseπ beginπ Current^.Up23:=Nil;π Current^.Down23:=Nil;π end;π end;π Prev^.Next:=Current;π Last:=Current;π if Line<=60 thenπ Line:=Line + 1;π end;πend;ππProcedure DrawScreen( This : StrPtr);πVarπ TRow : Byte;πbeginπ TRow:=1;π While TRow<=23 Doπ beginπ GotoXY(1,TRow);π Write(PadString(This^.Line));π This:=This^.Next;π TRow:=TRow + 1;π end;πend;ππProcedure Scrolling;πVarπ InKey : Char;πbeginπ While (MemAvail>272) and (not Eof(F)) Do AddString;π if not Eof(F) thenπ beginπ GotoXY(1,1);π TextColor(10);π Write('Entire File not Loaded');π end;π Current:=First;π Window(1,1,1,79);π ClrScr;π HighLite;π GotoXY(1,1);π Write(PadString(ParamStr(1)));π Window(2,1,24,80);π Normal;π DrawScreen(First);π Row:=1;π Window(2,1,25,80);π While InKey<>#27 Doπ beginπ InKey:=ReadKey;π Case InKey ofπ Null :π beginπ InKey:=ReadKey;π Case InKey ofπ UpArrow :π beginπ if Current^.Prev = Nil thenπ beginπ Sound(2000);π Delay(50);π NoSound;π endπ elseπ beginπ if Row = 1 thenπ beginπ GotoXY(1,1);π Normal;π Write(PadString(Current^.Line));π GotoXY(1,1);π InsLine;π Current:=Current^.Prev;π HighLite;π Write(PadString(Current^.Line));π endπ elseπ beginπ GotoXY(1,Row);π Normal;π Write(PadString(Current^.Line));π Row:=Row - 1;π GotoXY(1,Row);π HighLite;π Current:=Current^.Prev;π Write(PadString(Current^.Line));π end;π end;π end;ππ DownArrow :π beginπ if Current^.Next = Nil thenπ beginπ Sound(2000);π Delay(50);π NoSound;π endπ elseπ beginπ if Row = 23 thenπ beginπ GotoXY(1,23);π Normal;π Write(PadString(Current^.Line));π GotoXY(1,1);π DelLine;π GotoXY(1,23);π Current:=Current^.Next;π HighLite;π Write(PadString(Current^.Line));π endπ elseπ beginπ GotoXY(1,Row);π Normal;π Write(PadString(Current^.Line));π Row:=Row + 1;π GotoXY(1,Row);π HighLite;π Current:=Current^.Next;π Write(PadString(Current^.Line));π end;π end;π end;ππ PageDown :π beginπ if (Row = 23) and (Current = Last) thenπ beginπ Sound(2000);π Delay(50);π NoSound;π endπ elseπ beginπ Normal;π if Current^.Down23 = Nil thenπ beginπ Current:=Last;π DrawScreen(Last^.Up23);π Row:=23;π GotoXY(1,Row);π HighLite;π Write(PadString(Current^.Line));π endπ elseπ beginπ Current:=Current^.Down23^.Next;π DrawScreen(Current^.Up23);π Row:=23;π GotoXY(1,Row);π HighLite;π Write(PadString(Current^.Line));π end;π end;π end;ππ PageUp :π beginπ if (Row = 23) and (Current^.Up23 = Last) thenπ beginπ Sound(2000);π Delay(50);π NoSound;π endπ elseπ beginπ Normal;π if Current^.Up23 = Nil thenπ beginπ Current:=First;π DrawScreen(First);π Row:=1;π GotoXY(1,Row);π HighLite;π Write(PadString(First^.Line));π endπ elseπ beginπ Current:=Current^.Up23^.Prev;π DrawScreen(Current);π Row:=1;π GotoXY(1,Row);π HighLite;π Write(PadString(Current^.Line));π end;π end;π end;π elseπ beginπ Sound(2000);π Delay(50);π NoSound;π end;ππ end;π end;ππ elseπ beginπ Sound(2000);π Delay(50);π NoSound;π end;ππ end;π end;πend;ππbeginπ if ParamCount < 1 thenπ beginπ WriteLn('Invalid Number of Parameters!!!');π Halt(1);π end;π Assign(F, Paramstr(1));π Reset(F);π Current:=Nil;π First:=Nil;π Scrolling;π GotoXY(1, 23);π WriteLn;π WriteLn;πend.ππ 3 05-28-9313:56ALL SWAG SUPPORT TEAM SCROLL3.PAS IMPORT 33 B╡l⌠ {π Here is some demo code showing how to use Smooth.Obj. It offersπ vertical and horizontal smooth scrolling in Text or Graphics modes.ππ NOTE: Requires Smooth.Obj (see below) EGA & VGA ONLY !!!!ππ REQUIRES: Smooth.Obj Run the debug script through DEBUG to createπ Smooth.Obj. The NEXT message has the debug script.ππ ALSO: Until last week, I'd never seen a line of Pascal code.π So ForGIVE the rough edges of this code: bear in mindπ the Complete novice status of its author <!!G!!> }ππUses Crt;ππ{ NOTE: SmoothScroll is a MEDIUM MODEL Asm/OBJ For use inπ **either** Pascal or most flavors of modern BASIC.ππ It expects parameters to be passed by reference! We handleπ that here by not including Var, then passing Ofs(parameter).ππ Don't know if this is appropriate, but it works. Comments? }ππ{$F+} Procedure SmoothScroll(Row, Column: Integer); external; {$F-}π{$L Smooth.Obj}ππVarπ Row, Col, Speed, WhichWay : Integer;π Ch : Char;π s : String [60];ππbeginπ TextColor (14); TextBackground (0); ClrScr;ππ GotoXY (25,4); Write ('Press <Escape> to move on.');ππ ch := 'A';π For Row := 10 to 24 doπ beginπ FillChar (s, Sizeof(s), ch);π s[0] := #60; Inc (ch);π GotoXY (10, Row); Write (s);π end;ππ Speed := 1; { Change Speed! See notes. }ππ {The higher the Speed, the faster the scroll.π Use Speed = 1 For subtle scrolling.π Try Speed = 5 (10 in Graphics) For very fast scrolling.π Try Speed = 10+ (25 in gfx) to see some **Real shaking**.ππ Even in Text mode here, Row and Column use GraphICS MODEπ pixel coordinates (ie., begin w/ 0,0). }ππ {================================= demo vertical smooth scrolling}π Row := 0; Col := 0;π WhichWay := Speed; { start by going up }ππ Repeat { press any key to end demo }π GotoXY (2,10); Write (Row, ' ');π SmoothScroll(ofs(Row), ofs(Col));π Row := Row + WhichWay;ππ if (Row > 150) or (Row < 2) then { try 400 here }π WhichWay := WhichWay * -1; { reverse direction }ππ if Row < 1 then Row := 1;ππ Until KeyPressed;ππ ch := ReadKey; Row := 0; Col := 0;π SmoothScroll ( ofs(Row), ofs(Col) ); { return to normal (sort of) }ππ {================================= demo horizontal smooth scrolling}π Row := 0; Col := 0;π WhichWay := Speed; { start by going left }ππ Repeat { press any key to end demo }π GotoXY (38,3); Write (Col, ' ');π SmoothScroll(ofs(Row), ofs(Col));π Col := Col + WhichWay;ππ if (Col > 65) or (Col < 0) then { try 300 here }π WhichWay := WhichWay * -1; { reverse direction }π if Col < 0 then Col := 0;π Until KeyPressed;ππ Row := 0; Col := 0; SmoothScroll(ofs(Row), ofs(Col));πend.ππ{ Capture the following to a File (eg. S.Scr).π then: DEBUG < S.SCR.ππ Debug will create SMOOTH.OBJ.ππ N SMOOTH.OBJπ E 0100 80 0E 00 0C 73 6D 74 68 73 63 72 6C 2E 61 73 6Dπ E 0110 87 96 27 00 00 06 44 47 52 4F 55 50 0D 53 4D 54π E 0120 48 53 43 52 4C 5F 54 45 58 54 04 44 41 54 41 04π E 0130 43 4F 44 45 05 5F 44 41 54 41 90 98 07 00 48 89π E 0140 00 03 05 01 87 98 07 00 48 00 00 06 04 01 0E 9Aπ E 0150 04 00 02 FF 02 5F 90 13 00 00 01 0C 53 4D 4F 4Fπ E 0160 54 48 53 43 52 4F 4C 4C 00 00 00 A7 88 04 00 00π E 0170 A2 01 D1 A0 8D 00 01 00 00 55 8B EC 06 56 33 C0π E 0180 8E C0 8B 76 08 8B 04 33 D2 26 8B 1E 85 04 F7 F3π E 0190 8B D8 8B CA 26 A1 4A 04 D0 E4 F7 E3 8B 76 06 8Bπ E 01A0 1C D1 EB D1 EB D1 EB 03 D8 26 8B 16 63 04 83 C2π E 01B0 06 EC EB 00 A8 08 74 F9 EC EB 00 A8 08 75 F9 26π E 01C0 8B 16 63 04 B0 0D EE 42 8A C3 EE 4A B0 0C EE 42π E 01D0 8A C7 EE 4A 83 C2 06 EC EB 00 A8 08 74 F9 83 EAπ E 01E0 06 B0 08 EE 8A C1 42 EE 83 C2 05 EC BA C0 03 B0π E 01F0 33 EE 8B 76 06 8B 04 24 07 EE 5E 07 8B E5 5D CAπ E 0200 04 00 F5 8A 02 00 00 74π RCXπ 0108π Wπ Qππ'======== end of Debug Script ========π}ππ 4 05-28-9313:56ALL SWAG SUPPORT TEAM SCROLL4.PAS IMPORT 12 B╡≈h {> I need to be able to scroll the Text display in my File viewer,π> both left and right, to allowing reading of lines that extend pastπ> column 80.ππUnFortunately there's no way to scroll horizontally by BIOS or by anotherπservice Function. You have to implement it on your own. Here are two Proceduresπthat I use in my Programs (in Case they must scroll left or right ;-)):π}ππ{$ifNDEF VER70}πConstπ Seg0040 = $0040;π SegB000 = $B000;π SegB800 = $B800;π{$endif}ππTypeπ PageType = Array [1..50,1..80] of Word;ππVarπ Screen : ^PageType;π VideoMode : ^Byte;ππProcedure ScrollRight(X1,Y1,X2,Y2,Attr : Byte);πVarπ Y : Byte;π Attrib : Word;πbeginπ Attrib := Word(Attr SHL 8);π Y := Y1-1;π Repeatπ Inc(Y);π Move(Screen^[Y,X1],Screen^[Y,X1+1],(X2-X1)*2);π Screen^[Y,X1] := Attrib+32;π Until Y=Y2;πend;ππProcedure ScrollLeft(X1,Y1,X2,Y2,Attr : Byte);πVarπ Y : Byte;π Attrib : Word;πbeginπ Attrib := Word(Attr SHL 8);π Y := Y1-1;π Repeatπ Inc(Y);π Move(Screen^[Y,X1+1],Screen^[Y,X1],(X2-X1)*2);π Screen^[Y,X2] := Attrib+32;π Until Y=Y2;πend;ππbeginπ VideoMode := Ptr(Seg0040,$0049);π if VideoMode^=7 thenπ Screen := Ptr(SegB000,$0000)π elseπ Screen := Ptr(SegB800,$0000);πend.ππ{πX1, Y1, X2 and Y2 are the coordinates of the Windows to be scrolled. Attr isπthe color of the vertical line that occurs after scrolling. ;-)π}π 5 06-08-9308:17ALL LOU DUCHEZ Write w/ Scroll Control IMPORT 33 B╡àÜ (*π===========================================================================π BBS: Canada Remote SystemsπDate: 06-01-93 (06:21) Number: 24456πFrom: LOU DUCHEZ Refer#: NONEπ To: MICHAEL DEAKINS Recvd: NO πSubj: ANSI, BATCH FILE EXEC'ING Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πMD>I have two questions. First, How can I display ANSI files from a PascalπMD>program by using the CON driver (read: ANSI.SYS) instead of going to theπMD>trouble of writing a terminal emulator, and still remainπMD>window-relative? I used TP5.5's WRITE procedure to write to a fileπMD>assigned to the CON device instead of the CRT unit's standard OutPut,πMD>but this obliterated my status line at the bottom of the screen when theπMD>ANSI file scrolled. Is there an easy way to write to the CON deviceπMD>while remaining window-relative without having to modify ANSI.SYS orπMD>write a terminal emulation procedure?πMD> My second question: How can I call a batch file from within a PascalπMD>program and pass %1-%9 parameters to it? I'm aware of the EXECπMD>procedure, but doesn't that only work on executables?ππSecond question first: you're right about EXEC calling only executables.πSo try calling "COMMAND.COM" as your program, and give it parameters ofπ"/C " plus the batch file name plus whatever arguments you intend to pass.π(That tells the system to run a single command out of DOS.) Look upπParamCount and ParamStr() to see how Pascal uses command-line parameters.ππFirst question second: you know, I addressed this problem just yesterdayπtrying to write a program. I concluded that, if you're going to bypassπCRT, you need to do a lot of "manual" work yourself to keep a windowπgoing. Let me show you the tools I devised:π*)πππ{---PROCEDURE ATSCROLL: SCROLLS A SCREEN REGION UP OR DOWN (negative orπ positive number in LINESDOWN, respectively) }ππprocedure atscroll(x1, y1, x2, y2: byte; linesdown: integer);πvar tmpbyte, intbyte, clearattrib: byte;πbeginπ if linesdown <> 0 then beginπ clearattrib := foxfore + foxback shl 4;π x1 := x1 - 1;π y1 := y1 - 1;π x2 := x2 - 1;π y2 := y2 - 1;π if linesdown > 0 then intbyte := $07 else intbyte := $06;π tmpbyte := abs(linesdown);π asmπ mov ah, intbyteπ mov al, tmpbyteπ mov bh, clearattribπ mov ch, y1π mov cl, x1π mov dh, y2π mov dl, x2π int 10hπ end;π end;π end;ππππ{---FUNCTION YPOS: Returns the line the cursor is on. I wrote it becauseπ I don't always trust WHEREY (or WHEREX): they report, for example, theπ cursor position relative to a text window. So I had it lying around,π and I opted to use it in my routines. }ππfunction ypos: byte;πvar tmpbyt: byte;πbeginπ asmπ mov ah, 03hπ mov bh, 0π int 10hπ mov tmpbyt, dhπ end;π ypos := tmpbyt + 1;π end;ππππ{--- PROCEDURE WRITEANDFIXOVERHANG: I use it in place of WRITELN in myπ program: before writing a line of text, it checks if there's roomπ at the bottom of the screen. If not, it scrolls the screen upπ before writing. Keep in mind that this program is bent on preservingπ the top three or four screen lines, not the bottom lines. }ππprocedure writeandfixoverhang(strin: string);πconst scrollat: byte = 24;πvar overhang: byte;πbeginπ if ypos >= scrollat then beginπ overhang := ypos - scrollat + 1;π atscroll(0, 4 + overhang, 0, 80, 25, -overhang);π movecursor(1, ypos - overhang);π end;π writeln(strin);π end;ππ{πSo assuming your text lines don't get too long (line longer than 160 chars),πthese routines will keep the top of your screen from getting eaten. If youπwant to preserve space at the bottom of the screen instead (or both top andπbottom), change WRITEANDFIXOVERHANG.ππBTW, if there are any compiling problems, let me know. I took out all theπstuff that applied specifically to my application -- I might have stupidlyπchanged something you need ... }π 6 11-02-9306:14ALL BERNIE PALLEK Quick Scroller SWAG9311 17 B╡ {πBERNIE PALLEKππ>Would anyone happen to know how I can use the ASCII Charactersπ>while in Video mode $13 (320x200x256)? Or better yet, make a messageπ>scroll across the screen like in them neat intros and demos..ππThe easiest way to do it is to set DirectVideo to False (if you are usingπthe Crt Unit). This disables direct Writes to the screen, meaning thatπthe BIOS does screen writing, and the BIOS works in just about everyπscreen mode. Then, you can just use Write and WriteLn to display TextπCharacters (I think GotoXY will even work). As For scrolling...πSince mode 13h ($13) has linearly addressed video memory (just a runπof 64,000 contiguous Bytes), do something like this:ππthis is untested, but it might actually work :')π}ππUsesπ Crt;πConstπ msgRow = 23;π waitTime = 1; { adjust suit your CPU speed }π myMessage : String = 'This is a test message. It should be more ' +π 'than 40 Characters long so the scrolling can be demonstrated.';πVarπ sx, xpos : Byte;ππProcedure MoveCharsLeft;πVarπ curLine : Word;πbeginπ { shift the row left 1 pixel }π For curLine := (msgRow * 8) to (msgRow * 8) + 7 DOπ Move(Mem[$A000 : curLine * 320 + 1], Mem[$A000 : curLine * 320], 319);π { clear the trailing pixels }π For curLine := (msgRow * 8) to (msgRow * 8) + 7 DOπ Mem[$A000 : curLine * 320 + 319] := 0;πend;ππbeginπ Asmπ MOV AX, $13π INT $10π end;π DirectVideo := False;π GotoXY(1, msgRow + 1);π Write(Copy(myMessage, 1, 40));π { 'myMessage' must be a String With a Length > 40 }π For xpos := 41 to Length(myMessage) doπ beginπ For sx := 0 to 7 doπ beginπ MoveCharsLeft;π Delay(waitTime);π end;π GotoXY(40, msgRow + 1);π Write(myMessage[xpos]);π end;π Asmπ MOV AX, $3π INT $10π end;πend.ππ{πThis may not be very efficiently coded. As well, it could benefit fromπan Assembler version. But it should at least demonstrate a techniqueπyou can learn from. }ππ 7 11-02-9306:14ALL DANIEL JOHN LEE PARNELL Scrolling Demo SWAG9311 71 B╡ {πS921878@MINYOS.XX.RMIT.OZ.AU, Daniel John Lee Parnellππ I have received several requests for the source code to theπscrolly demo I posted to this group. Sorry about posting a binary. Iπdidn't know it was not allowed on this group. Anyway the following is theπsource code to the scrolly. It is not a unit. It uses one 286πinstruction so it wont work on an XT :(π}ππ{$G+}πprogram ColorBars;ππusesπ DOS, CRT;ππconstπ maxBars = 7;π maxStars = 100;π maxLines = 7;π m : array [1..maxLines] of string =π ('Welcome to my first scrolly demo on the PC. It was written using ',π 'Turbo Pascal 6.0 on the 7th of October 1993. This program took me ',π 'about 2 hours to write and I had a lot of fun writing it! ',π 'I suppose I''d better put in some greets I guess...............',π 'Greetings go to Robyn Adam Rowan Mandy ',π ' Weng Speed Shane Iceberg Inc. And anybody ',π 'else out there whom I have forgotten about...... ');ππvarπ colors : array [0..768] of byte;π rMsk,π gMsk,π bMsk : array [0..255] of byte;π y, dy, s : array [1..maxBars] of integer;π sx, sy,π sdx : array [1..maxStars] of integer;π tx, ty : array [0..640] of integer;π dot : integer;π ticks : word;π scrly : array [0..360] of integer;π mpos,π mlen : integer;ππprocedure SetMode(m : integer); { Set video mode }πvarπ regs : registers;πbeginπ regs.ax := m;π intr($10, regs);πend;ππprocedure WaitRetrace; { Wait for vertical retrace }πbeginπ repeat { Nothing } until (Port[$03da] and 8) <> 0;πend;ππprocedure WaitNotRetrace; { Wait for not vertical retrace }πbeginπ repeat { Nothing } until (Port[$03da] and 8) <> 8;πend;ππprocedure InitScreen; { Sets up the colored bars }πvarπ i, j : integer;πbeginπ for i := 0 to 199 doπ for j := 0 to 319 doπ mem[$a000 : i * 320 + j] := i;πend;ππprocedure InitColors; { Zeros the first 200 colors }πvarπ i : integer;πbeginπ for i := 0 to 199 * 3 doπ colors[i] := 0;πend;ππprocedure SetColors; assembler; { Loads the colors into the regs }πasmπ @ntrace: { Wait for not retrace }π mov dx, $03daπ in al, dxπ test al, 8π jnz @vtraceππ @vtrace: { Now wait for retrace }π mov dx, $03daπ in al, dxπ test al, 8π jz @vtraceππ mov dx, $03c8 { Start changeing colors from color # 1 }π mov al, 1π out dx, alππ inc dx { Make DX point to the color register }π mov cx, 199*3 { The number of bytes to put into the color register }π mov si, offset colors { Load the address of the color array }π rep outsb { Now change the colors }πend;ππprocedure CalcBars; { Calculate the color bars }πvarπ i, j, k : integer;πbeginπ for i := 0 to 199 * 3 do { Zero all the colors }π colors[i] := 0;ππ for i := 1 to maxBars do { Now process each bar in turn }π beginπ y[i] := y[i] + dy[i]; { Move the bar }π if (y[i] < 4) or (y[i] > 190) then { Has it hit the top or the bottom? }π beginπ dy[i] := -dy[i]; { Yes, so make it bounce }π y[i] := y[i] + dy[i];π end;ππ for j := (y[i] - s[i]) to (y[i] + s[i]) do { Now update the color array }π beginπ if j < y[i] then { Calculate the intensity }π k := 63 - (y[i] - j) * 4π elseπ k := 63 - (j - y[i]) * 4;ππ if j > 0 then { If it is a valid color change it }π beginπ colors[j * 3] := (colors[j * 3] + (k and rMsk[i])); { Do red }π colors[j * 3 + 1] := (colors[j * 3 + 1] + (k and gMsk[i])); { Do green }π colors[j * 3 + 2] := (colors[j * 3 + 2] + (k and bMsk[i])); { Do blue }π end;π end;π end;πend;ππprocedure InitBars; { Set up the bars randomly }πvarπ i : integer;πbeginπ for i := 1 to MaxBars doπ beginπ y[i] := random(150)+4; { Starting pos }π s[i] := random(6)+4; { Size }ππ rMsk[i] := random(2)*255; { Red mask }π gMsk[i] := random(2)*255; { Green mask }π bMsk[i] := random(2)*255; { Blue mask }ππ repeat { Calc direction }π dy[i] := random(6) - 3;π until dy[i] <> 0;π end;πend;ππprocedure InitStars; { Set up the stars }πvarπ i : integer;πbeginπ port[$03c8] := $f8; { Change the colors for stars }π for i := 7 downto 0 doπ beginπ port[$03c9] := 63 - (i shl 2);π port[$03c9] := 63 - (i shl 2);π port[$03c9] := 63 - (i shl 2);π end;ππ for i := 1 to maxStars doπ beginπ sx[i] := random(320); { Choose X pos }π sy[i] := random(200); { Y pos }π sdx[i] := 1 shl random(3); { Speed }π end;πend;ππprocedure InitScroll; { Initialize the scrolly }πconstπ k = 3.141 / 180;πvarπ i : integer;πbeginπ mlen := 0; { Calc length of scroll text }π for i := 1 to maxLines doπ mlen := mlen + length(m[i]);ππ for i := 0 to 640 do { Zero all the star positions }π tx[i] := -1;ππ for i := 0 to 360 do { Calculate the scroll path }π scrly[i] := round(100 + 50 * sin(i * k));πend;ππprocedure UpdateStars; { Draw the stars }πvarπ i, ad : integer;πbeginπ for i := 1 to maxStars doπ beginπ ad := sx[i] + sy[i] * 320; { Calc star address in video ram }π mem[$a000 : ad] := sy[i]; { Unplot old star pos }π sx[i] := sx[i] + sdx[i]; { Calc new star pos }ππ if sx[i] > 319 then { Is it past the end of the screen? }π beginπ sy[i] := random(200); { Yes, generate a new star }π sx[i] := 0;π sdx[i] := 1 shl random(3);π ad := sx[i] + sy[i] * 320;π end;π mem[$a000:ad + sdx[i]] := $f7 + (sdx[i]) * 2;π end;πend;ππfunction msg(var i : integer) : char; { Get a char from the scroll text }πvarπ j, t, p : integer;πbeginπ if i > mlen then { Is I longer then the text? }π i := 1;ππ j := 0; { Find which line it is in }π t := 0;π repeatπ inc(j);π t := t + length(m[j]);π until i<t;ππ p := i - t + length(m[j]); { Calculate position in line }ππ if p > 0 thenπ msg := m[j][p]π elseπ msg := chr(0);π inc(i); { Increment text position }πend;ππprocedure NextChar; { Create nex character in scroll text }πvarπ ad : word;π i, j,π q, c : integer;πbeginπ c := ord(msg(mpos)); { Get the char }ππ ad := $fa6e + (c * 8); { Calc address of character image in ROM }π for i := 0 to 7 doπ beginπ q := mem[$f000 : ad + i]; { Get a byte of the image }π for j := 0 to 7 doπ beginπ if odd(q) then { Is bit 0 set? }π beginπ tx[dot] := 320 + (7 - j) * 4; { If so add a dot to the list }π ty[dot] := i * 4;π inc(dot);π if dot > 640 thenπ dot := 0;π end;π q := q shr 1; { Shift the byte one pos to the right }π end;π end;πend;ππprocedure DisplayScroll; { Display scrolly and update dot positions }πvarπ i : integer;π ad : word;πbeginπ if (ticks mod 32) = 0 then { Is it time for the next char? }π NextChar;ππ for i := 0 to 640 doπ if tx[i] > 0 then { Is this dot being used? }π beginπ if tx[i] < 320 then { Is it on the screen? }π beginπ ad := tx[i] + (ty[i] + scrly[tx[i]]) * 320; { Calc old position }π mem[$a000:ad] := ty[i] + scrly[tx[i]]; { Clear old dot }π end;ππ dec(tx[i]); { Move dot to the left }π ad := tx[i] + (ty[i] + scrly[tx[i]]) * 320; { Calc new position }ππ if (tx[i] > 0) and (tx[i] < 320) then { Is it on the screen? }π mem[$a000:ad] := $ff - (ty[i] shr 2); { Plot new dot }ππ end;πend;ππbeginπ randseed := 4845267; { Set up the random seed }π SetMode($13); { Go to 320*200*256 mode }π InitColors; { Blank the color array }π SetColors; { Set the colors to black }π InitScreen; { Set up the colored bars }π InitBars; { Set up the bar positions }π InitStars; { Set up the stars }π InitScroll; { Set up the scrolly }π dot := 0; { Set the dot counter to 0 }π mpos := 1; { Set up the text pos }ππ repeatπ CalcBars; { Calculate the color bars }π DisplayScroll; { Display the scrolly text }π UpdateStars; { Update & display the stars }π SetColors; { Set the colors }π inc(ticks); { Update the tick counter }π until KeyPressed;ππ SetMode(3); { Return to text mode }πend.π
